home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 10
/
FM Towns Free Software Collection 10.iso
/
ms_dos
/
lib
/
happysrc
/
pctype.c
< prev
next >
Wrap
Text File
|
1994-11-14
|
32KB
|
821 lines
/*********************************************************************
*
* *** HAPPy Pascal compiler ***
*
* 型の処理
*
* void typ(Set fsys,stp **fsp,int *fsize)
*
*
* Copyright (c) H.Asano 1992
*
*********************************************************************/
#define EXTERN extern
#include <string.h>
#include "pascomp.h"
extern void pcerr(int,char*) ;
extern char *inttoch(long) ;
extern Set *orset(Set*,Set*) ;
extern Set *mkset(Set*,int,...) ;
extern Set *dfset(Set*,Set*) ;
extern void insymbol(void) ;
extern void skip(Set) ;
extern ctp *mkctp(char*,enum idclass,stp*,ctp*) ;
extern void enterid(ctp*) ;
extern ctp *searchid(Set) ;
extern ctp *searchsection(ctp*) ;
extern int align(stp*,int) ;
extern boolean string(stp*) ;
extern void constant(Set, stp**, union valu*);
extern void getbounds(stp*,long*,long*) ;
extern boolean compatible(stp*,stp*) ;
extern void *Malloc(int) ;
extern void applied(ctp*,int) ;
static boolean simpletype(Set,stp**,int*) ;
static stp *enumtype(Set) ;
static stp *subrtype1(Set,ctp*) ;
static stp *subrtype2(Set,ctp*) ;
static boolean complextype(Set,stp**) ;
static stp *pointertype(Set) ;
static boolean packedtype(Set) ;
static stp *recordtype(Set,boolean,boolean*);
static boolean fieldlist(Set,stp**,int*) ;
static boolean varfield(Set,stp**,int*) ;
static boolean varelement(Set,stp*,stp**,int**);
static stp *settype(Set,boolean) ;
static stp *filetype(Set,boolean) ;
static stp *arraytype(Set,boolean,boolean*) ;
/**************************************/
/* typ() : 型の処理メイン */
/**************************************/
boolean typ(Set fsys,stp **fsp,int *fsize)
{
boolean fileflag = false ;
Set ws ;
if(! inset(typebegsys,sy)) {
pcerr(10,"") ; /* 型の記述に誤りがある */
ws = fsys ;
orset(&ws,&typebegsys) ;
skip(ws) ; /* fsys+typebegsysまで読み飛ばし */
}
if(inset(typebegsys,sy)) { /* symbolがtypebegsysにある時 */
if(inset(simptypebegsys,sy)) /* 単純型の時 */
fileflag = simpletype(fsys,fsp,fsize) ;/* 単純型の処理 */
else
fileflag = complextype(fsys,fsp) ; /* 構造型の処理 */
}
else *fsp = nil ;
if(*fsp) {
*fsize = (*fsp)->size ;
(*fsp)->assignflag = !fileflag ; /* 代入可能フラグ設定 */
}
else *fsize = 1 ;
return(fileflag) ;
}
/***********************************************/
/* simpletype() : 単純型の処理 */
/* */
/* 単純型 ::= 列挙型 | 部分範囲型 | 型名 */
/* 列挙型 ::= (名前,名前・・・) */
/* 部分範囲型 ::= 定数 .. 定数|定数名 */
/* 部分範囲型 ::= 定数名 .. 定数名|定数 */
/* 型名 ::= 名前 */
/* */
/***********************************************/
static boolean simpletype(Set fsys,stp **fsp,int *fsize)
{
stp *lsp ;
ctp *lcp ;
boolean fileflag = false ;
Set ws ;
*fsize = 1 ;
if(! inset(simptypebegsys,sy)) {
pcerr(1,"") ; /* 単純な型に誤りがある */
ws = fsys ;
orset(&ws, &simptypebegsys) ;
skip(ws) ; /* fsys+simtypebegsysまで読み飛ばし */
}
if(inset(simptypebegsys,sy)) { /* 単純型の始めのsymbolの時 */
switch(sy) {
case lparent : /* ( */
lsp = enumtype(fsys) ; /* 列挙型の処理 */
break ;
case ident : /* 名前 */
mkset(&ws, konst,types, -1) ;
lcp = searchid(ws) ; /* 定数か型名から名前を探す */
applied(lcp,level) ; /* 引用名チェーン */
insymbol() ; /* 次のsymbolを読んでおく */
if(lcp->klass == konst) { /* 定数名 */
lsp = subrtype1(fsys,lcp); /* 範囲型1の処理 */
}
else { /* 型名 */
lsp = lcp->idtype ;
if(lsp) {
*fsize = lsp->size ;
fileflag=!(lsp->assignflag); /* 代入可能とfileありは反転関係*/
}
}
break ;
default : /* 定数 */
lsp = subrtype2(fsys,lcp) ; /* 範囲型2の処理 */
}
if((lsp) && (lsp->form == subrange)
&& (lsp->sf.su.rangetype) )
if(lsp->sf.su.rangetype == realptr) /* 範囲型の元の型が実数型 */
pcerr(109,"") ; /* 範囲型は実数では駄目 */
else
if(lsp->sf.su.min > lsp->sf.su.max)
pcerr(102,"") ; /* 下限が上限より大きい */
if(! inset(fsys,sy)) {
pcerr(6,"") ; /* 不当な記号が現れた */
skip(fsys) ;
}
*fsp = lsp ;
}
else *fsp = nil ; /* not (sy in simptypebegsys) */
return(fileflag) ;
}
/****************************************/
/* enumtype() : 列挙型の処理 */
/* 列挙型 := (名前,名前,名前,・・・・・) */
/****************************************/
static stp *enumtype(Set fsys)
{
int ttop ;
stp *lsp ;
ctp *lcp, *lcp1 = nil ;
int lcnt = 0 ; /* 各名前の値生成用のカウンタ */
Set ws ;
ttop = top ; /* 今のdisplayのtopを退避 */
while(display[top].occur != blck) /* blockの水準をサーチ */
top-- ;
lsp = (stp*)Malloc(sizeof(stp)) ;
lsp->form = scalar ;
lsp->size = intsize ;
lsp->sf.sc.scalkind = declared ;
do {
insymbol() ;
if(sy == ident) { /* 各要素は名前である */
lcp = mkctp(id,konst,lsp,lcp1) ; /* 名前のエリアを確保 */
lcp->n.values.ival = lcnt++ ; /* 各名前の値を入れる */
enterid(lcp) ; /* 名前を登録 */
lcp1 = lcp ;
insymbol() ;
}
else pcerr(2,"") ; /* 名前がない */
mkset(&ws,comma,rparent,-1) ;
orset(&ws, &fsys) ;
if(! inset(ws,sy)) { /* , ) fsys のsymbolでない */
pcerr(6,"") ; /* 不当な記号が現れた */
skip(ws) ; /* fsys , ) までで読み飛ばし */
}
} while(sy == comma) ; /* , で区切られるならば次へ */
lsp->sf.sc.fconst = lcp1; /* 列挙型の最後の名前へのポインタ */
top = ttop ; /* displayの水準を元に戻す */
if(sy == rparent) insymbol() ; /* ) なら次のsymbolを読む */
else pcerr(4,"") ; /* ) がない */
return(lsp) ;
}
/****************************************/
/* subrtype1() : 範囲型1の処理 */
/* 範囲型1 := 定数名..定数名|定数 */
/****************************************/
static stp *subrtype1(Set fsys, ctp *lcp)
{
stp *lsp,*lsp1 ;
union valu lvalu ;
lsp = (stp*)Malloc(sizeof(stp));
lsp->form = subrange ;
lsp->sf.su.rangetype = lcp->idtype ;
if(string(lsp->sf.su.rangetype)) { /* 定数が文字列型か調べる */
pcerr(109,"") ; /* 範囲型はの型は順序型 */
lsp->sf.su.rangetype = nil ;
}
lsp->sf.su.min = lcp->n.values.ival;/* 下限値を入れる */
lsp->size = intsize ;
if(sy == period2) insymbol() ; /* .. の時 上限のsymbolを読む*/
else pcerr(22,"") ; /* .. がない */
constant(fsys, &lsp1, &lvalu) ; /* 上限の処理 */
lsp->sf.su.max = lvalu.ival ; /* 上限値を入れる */
if(lsp->sf.su.rangetype != lsp1)
pcerr(107,"") ; /* 2つの型が一致しない */
return(lsp) ;
}
/****************************************/
/* subrtype2() : 範囲型2の処理 */
/* 範囲型2 := 定数..定数|定数名 */
/****************************************/
static stp *subrtype2(Set fsys, ctp *lcp)
{
stp *lsp,*lsp1 ;
union valu lvalu ;
Set ws ;
lsp = (stp*)Malloc(sizeof(stp)) ;
lsp->form = subrange ;
lsp->size = intsize ; /* 範囲型となれるのは整数のみ*/
ws = fsys ;
addset(ws,period2) ;
constant(ws, &lsp1, &lvalu) ; /* 下限値の処理 */
if(string(lsp1)) {
pcerr(109,"") ; /* 範囲型の型は順序型 */
lsp1 = nil ;
}
lsp->sf.su.rangetype = lsp1 ; /* 範囲型の元の型 */
lsp->sf.su.min = lvalu.ival; /* 下限値の設定 */
if(sy == period2) insymbol() ; /* .. なら次のsymbol(上限値) */
else pcerr(22,"") ; /* ..でなければ .. がない */
constant(fsys, &lsp1, &lvalu) ; /* 上限値の処理 */
lsp->sf.su.max = lvalu.ival ; /* 上限値の設定 */
if(lsp->sf.su.rangetype != lsp1) /* 上限値と下限値のタイプが違う時 */
pcerr(107,"") ; /* 範囲型の2つの型が不一致 */
return(lsp) ;
}
/***********************************************/
/* complextype() : 単純型以外の型の処理 */
/* */
/* ^ 型名 */
/* [packed] array[単純型,・・・] of 型 */
/* [packed] file of 型 */
/* [packed] set of 型 */
/* [packed] record 欄の並び end */
/***********************************************/
static boolean complextype(Set fsys,stp **fsp)
{
boolean packedflag ;
boolean fileflag = false ;
if(sy == arrow) *fsp=pointertype(fsys) ; /* ポインタ型 */
else {
packedflag = packedtype(fsys) ;
switch(sy) {
case arraysy : *fsp=arraytype(fsys,packedflag,&fileflag);
break ; /* 配列型 */
case recordsy : *fsp=recordtype(fsys,packedflag,&fileflag);
break ; /* レコード型 */
case setsy : *fsp=settype(fsys,packedflag) ; /* 集合型 */
break ;
case filesy : *fsp=filetype(fsys,packedflag); /* ファイル型 */
fileflag = true ;
}
}
return(fileflag) ;
}
/**************************************/
/* pointertype() : ポインタ型の処理 */
/**************************************/
static stp *pointertype(Set fsys)
{
stp *lsp ;
ctp *lcp ;
int ttop ;
Set ws ;
lsp = (stp*)Malloc(sizeof(stp)) ; /* 型のエリア 確保 */
lsp->form = pointer ;
lsp->size = ptrsize ;
lsp->sf.pt.eltype = nil ; /* とりあえずnilに */
insymbol() ; /* 次のsymbol(指し示す型名) */
if(sy == ident) {
if(typevar) { /* 型定義部の処理の時 */
ttop = top ;
do { /* ブロック水準から型名を探す */
lcp = searchsection(display[top].fname) ;
if(lcp)
if(lcp->klass == types) break ;
else lcp = nil ;
} while(display[top--].occur != blck);
top = ttop ;
if(!lcp) lcp = searchsection(display[0].fname) ;
/* 標準名から探す */
if(!lcp) { /* 見つからない(前方参照) */
lcp = mkctp(id,types,lsp,fwptr);/* 名前エリアを型名で確保する*/
fwptr = lcp ; /* forward pointerにつなぐ */
}
else /* 見つかった時 */
lsp->sf.pt.eltype = lcp->idtype;/* 指し示すものの型 */
}
else { /* 変数定義部の処理の時 */
mkset(&ws, types, -1);
lcp = searchid(ws) ; /* 被指示型を探す */
lsp->sf.pt.eltype = lcp->idtype; /* 指し示すものの型 */
}
if(lsp->sf.pt.eltype)
if(!lsp->sf.pt.eltype->assignflag)
pcerr(608,"") ; /* 局所ファイルは駄目 */
insymbol() ;
}
else pcerr(2,"") ; /* 名前がない */
return(lsp) ;
}
/**************************************/
/* arraytype() : 配列型の処理 */
/**************************************/
static stp *arraytype(Set fsys,boolean packedflag,boolean *fileflag)
{
stp *lsp,*lsp1,*lsp2 ;
int lsize = 1 ;
long range ;
long lmin , lmax ;
Set ws ;
boolean test ;
insymbol() ;
if(sy == lbrack) insymbol() ; /* [ ならば次のsymbolを読む */
else pcerr(11,"") ; /* [ でなければ [がないエラー */
lsp1 = nil ;
do {
lsp = (stp*)Malloc(sizeof(stp)) ;
lsp->form = arrays ;
lsp->sf.ar.packed = packedflag ; /* packed指定有無 */
lsp->sf.ar.aeltype = lsp1 ; /* 要素の型は前の添え字の型 */
lsp->sf.ar.inxtype = nil ; /* 添え字の型の初期設定 */
lsp1 = lsp ; /* 次回のループのために退避 */
mkset(&ws, comma,rbrack,ofsy,-1) ;
orset(&ws, &fsys) ;
simpletype(ws,&lsp2,&lsize) ; /* 添え字の型の処理 */
lsp->size = lsize ; /* 添え字の型の大きさ */
if(lsp2) {
if(lsp2->form <= subrange) { /* 添え字の型がscalar,subrange*/
if(lsp2 == realptr) { /* 実数型 */
pcerr(109,"") ; /* ここでは実数型は駄目 */
lsp2 = nil ;
}
}
else { /* 添え字の型がscalar,subrangeでない*/
pcerr(113,"") ; /* 添え字の型はスカラ、範囲型 */
lsp2 = nil ;
}
}
lsp->sf.ar.inxtype = lsp2 ; /* 添え字の型を入れる */
if(test=(sy==comma)) insymbol() ; /* , なら次のsymbol */
} while(test) ; /* , ならば繰り返す */
if(sy == rbrack) insymbol() ; /* ] なら次のsymbol */
else pcerr(12,"") ; /* ] がない */
if(sy == ofsy) insymbol() ; /* of なら次のsymbol */
else pcerr(8,"") ; /* ofがない */
*fileflag = typ(fsys,&lsp,&lsize); /* 要素の型の処理 */
do {
lsp2 = lsp1->sf.ar.aeltype ; /* 1つ前の添え字の型 */
lsp1->sf.ar.aeltype = lsp ; /* 要素の型を入れる */
lsp1->assignflag=lsp->assignflag; /* 代入可能フラグを受け継ぐ */
if(lsp1->sf.ar.inxtype) { /* 添え字の型がある時 */
getbounds(lsp1->sf.ar.inxtype,&lmin,&lmax) ; /* 型の最小,最大値*/
range = lmax - lmin + 1 ; /* 1つの配列の大きさ */
lsize = align(lsp,lsize) ; /* 要素の型のサイズ境界 */
if(range &&
((range > (long)Maxaddr) ||
((long)lsize > (long)Maxaddr/range))) {
pcerr(605,inttoch((long)Maxaddr)); /* 型の大きさ制限 */
lsize = 0 ; /* 以後同じエラーがでないよう */
}
lsize = lsize * (int)range ;
lsp1->size = lsize ; /* その型までのサイズを入れる */
}
lsp = lsp1 ;
lsp1 = lsp2 ;
} while(lsp1) ;
lsp->size = ((lsize > 1) ? lsize : 1) ; /* 1以上のサイズの設定 */
return(lsp) ;
}
/**************************************/
/* recordtype() : レコード型の処理 */
/**************************************/
static stp *recordtype(Set fsys,boolean packedflag,boolean *fileflag)
{
int oldtop ; /* displayのtopを退避しておく */
int disp1=0; /* レコード内相対番地 */
stp *lsp ; /* レコード型のポインタ */
stp *varp ; /* 可変部の型 (ない時はnil) */
Set ws1 ;
Set ws2 ;
insymbol() ;
oldtop = top ; /* displayのtopを退避 */
if(top < Displimit) { /* 最大ネスト数以下だったらOK*/
top++ ;
display[top].fname = nil ; /* 新しい水準のdisplayを初期化*/
display[top].flabel = nil ;
display[top].aname = nil ;
display[top].occur = rec ; /* レコード内定義 */
}
else pcerr(603,inttoch((long)Displimit)) ;
/* 名前の入れ子が深すぎる */
mkset(&ws1, endsy,-1) ;
orset(&ws1, &fsys) ;
mkset(&ws2, semicolon,-1) ; /* ws1 = fsys-[semicolon] */
dfset(&ws1, &ws2) ; /* +[endsy] */
*fileflag = fieldlist(ws1,&varp,&disp1) ;
/* フィールドの処理 */
lsp = (stp*)Malloc(sizeof(stp)) ; /* レコードの型エリアへの設定 */
lsp->form = records ;
lsp->size = disp1 ; /* レコードの大きさ */
lsp->sf.re.packed = packedflag ; /* packed指定有無 */
lsp->sf.re.fstfld = display[top].fname ; /* 最初の欄のアドレス */
lsp->sf.re.recvar = varp ; /* 可変部のアドレス(ない時はnil)*/
top = oldtop ; /* displayの水準を戻す */
if(sy == endsy) insymbol() ; /* endならば次のsymbol */
else pcerr(13,"") ; /* end がない */
return(lsp) ;
}
/**************************************/
/* fieldlist() : レコードの欄の処理 */
/**************************************/
static boolean fieldlist(Set fsys,stp **frecvar,int *disp)
{
ctp *lcp ;
ctp *nxt ;
ctp *nxt1 = nil ;
stp *lsp = nil ;
int lsize ;
Set ws ;
Set ws2 ;
boolean fileflag = false ;
boolean test ;
mkset(&ws, ident, casesy, -1) ;
orset(&ws, &fsys) ;
if(! inset(ws,sy)) { /* symbolがfsys,ident,caseでない*/
pcerr(19,"") ; /* 欄の並びに誤りがある */
skip(ws) ; /* 読み飛ばし */
}
while(sy == ident) { /* 固定部の処理 */
nxt = nxt1 ;
do {
if(sy == ident) { /* 名前の時 */
lcp = mkctp(id,field,nil,nxt) ; /* 名前エリアをfield属性で確保*/
enterid(lcp) ;
nxt = lcp ;
insymbol() ; /* 名前の次のsymbol */
}
else pcerr(2,"") ; /* 名前がない */
mkset(&ws, comma, colon, -1) ;
if(! inset(ws,sy)) { /* , : でない時 */
pcerr(6,"") ; /* 不当な記号が現れた */
addset(ws,semicolon) ;
addset(ws,casesy) ;
orset(&ws, &fsys) ;
skip(ws) ; /* 読み飛ばし */
}
if(test=(sy==comma)) insymbol(); /* , ならば次のsymbol */
} while(test) ; /* , ならば繰り返す */
if(sy == colon) insymbol() ; /* : ならば次のsymbol */
else pcerr(5,"") ; /* : がない */
mkset(&ws, casesy,semicolon,-1) ;
orset(&ws, &fsys) ;
fileflag |= typ(ws,&lsp,&lsize) ; /* 名前の型の処理 */
while(nxt != nxt1) { /* 名前の列に型を入れる */
nxt->idtype = lsp ;
*disp = align(lsp,*disp) ;
nxt->n.fldaddr = *disp ; /* レコード内の相対開始番地 */
if(Maxaddr-lsize < *disp) /* 大きすぎる */
pcerr(605,inttoch((long)Maxaddr)); /* 型の大きさ制限 */
else *disp += lsize ;
nxt = nxt->next ; /* 次の名前 */
}
nxt1 = lcp ; /* 次の型の名前の並びのために */
mkset(&ws , ident,casesy,semicolon,-1) ;
orset(&ws , &fsys) ;
mkset(&ws2, ident,casesy,-1) ;
orset(&ws2, &fsys) ;
while(sy == semicolon) {
insymbol() ;
if(! inset(ws,sy)) { /* symbolが名前,case,;でない時*/
pcerr(19,"") ; /* 欄の並びに誤りがある */
skip(ws2) ; /* 読み飛ばし */
}
}
}
if(sy == casesy) /* caseが現れたら */
fileflag |= varfield(fsys,frecvar,disp) ;
/* 可変フィールドの処理 */
else *frecvar = nil ; /* caseでなければ可変部はない */
return(fileflag) ;
}
/**************************************/
/* varfield() : 可変フィールドの処理 */
/**************************************/
static boolean varfield(Set fsys,stp **frecvar,int *disp)
{
stp *lsp,*lsptag;
ctp *lcp=nil,*lcptag ;
Set ws ;
char oldid[MaxIDlng+1] ;
enum symbol oldsy ;
lsp = (stp*)Malloc(sizeof(stp)) ;
lsp->form = tagfld ; /* タグ欄用のエリア */
lsp->sf.tg.tagfieldp = nil ;
lsp->sf.tg.tagtype = nil ;
lsp->sf.tg.fstvar = nil ;
*frecvar = lsp ; /* 可変部のタグ欄アドレス返却 */
insymbol() ;
if(sy == ident) {
strcpy(oldid,id) ;
oldsy = sy;
insymbol() ;
if(sy == colon) {
lcp = mkctp(oldid,field,nil,nil) ; /* タグ名のエリア確保 */
lcp->n.fldaddr = *disp ;
enterid(lcp) ;
insymbol() ;
}
else if(sy == ofsy) { /* ofの時(タグ欄省略) */
strcpy(id,oldid) ;
sy = oldsy ; /* 前読んだ名前は型名 */
oldsy = ofsy ;
}
else pcerr(5,"") ; /* : がない */
if(sy == ident) { /* 型名 の 処理 */
mkset(&ws, types, -1) ;
lcptag = searchid(ws) ; /* 型名からサーチする */
applied(lcptag,level) ; /* 引用名チェーン */
lsptag = lcptag->idtype ; /* 型名の型 */
if(lsptag) { /* 型がある場合 */
*disp = align(lsptag,*disp) ; /* 型に適応した割りつけ開始番地*/
if(Maxaddr < *disp-lsptag->size)
pcerr(605,inttoch((long)Maxaddr)); /* 型の大きさ制限 */
if(lcp) /* タグ欄がある時は */
lcp->n.fldaddr = *disp ; /* タグ欄の変位を設定 */
*disp += lsptag->size ; /* 次の変位のためにサイズ分進める*/
/* タグ欄がなくても場所は確保 */
if((lsptag->form <= subrange ) &&
(lsptag != realptr)) { /* 順序型 */
if(lcp) lcp->idtype = lsptag ; /* タグの型アドレス */
lsp->sf.tg.tagfieldp = lcp ;
lsp->sf.tg.tagtype = lsptag ;
}
else pcerr(110,"") ; /* タグの型は順序型以外は駄目 */
}
if(oldsy != ofsy) insymbol() ; /* of を読む */
else sy = oldsy ; /* すでにofを読んでいる時 */
}
else pcerr(2,"") ; /* 名前がない */
}
else { /* caseの次が名前でない場合 */
pcerr(2,"") ; /* 名前がない */
mkset(&ws, ofsy, lparent, -1) ;
orset(&ws, &fsys) ;
skip(ws) ; /* 読み飛ばし */
}
lsp->size = *disp ; /* タグ欄のまでの大きさ */
if(sy == ofsy) insymbol() ; /* ofなら次のsymbol */
else pcerr(8,"") ; /* ofがない */
return(varelement(fsys,lsptag,&(lsp->sf.tg.fstvar),&disp));
/* 可変要素の処理 */
}
/**************************************/
/* varelement() : 可変要素の処理 */
/**************************************/
static boolean varelement(Set fsys,stp *fsptag,stp **fsp,int **disp)
{
stp *lspconst,*lspfield,*lspvar=nil ;
stp *lsp1,*lsp2,*lsp4,*lsp5,*lsp6 ;
union valu lvalu ;
int minsize, maxsize ,ldisp ;
long range ; /* タグ型の取りえる要素の合計 */
long itemsu=0; /* 選択定数の指定数 */
Set ws ;
boolean fileflag = false ;
boolean test ;
boolean ok ;
range = (fsptag->form == subrange)
? fsptag->sf.su.max - fsptag->sf.su.min + 1 /* 範囲型の時*/
: fsptag->sf.sc.fconst->n.values.ival+1 ; /* 列挙型の時*/
lsp1 = lsp4 = nil ;
maxsize = minsize = ldisp = **disp ;
do {
lsp2 = nil ;
do {
ok = false ;
mkset(&ws, comma,colon,lparent,-1) ;
orset(&ws, &fsys) ;
constant(ws,&lspconst,&lvalu) ; /* 選択定数 */
if(string(lspconst) || (lspconst==realptr)) /* 文字列、実数型 */
pcerr(159,"") ; /* 文字列、実数型は指定不可 */
else if(fsptag) { /* タグ型がある時のみチェック */
if(! compatible(fsptag,lspconst))
pcerr(111,"") ; /* 見出しの型と一致していない */
else {
ok = true ;
if(fsptag->form == subrange) /* 部分範囲型の時 */
if((lvalu.ival < fsptag->sf.su.min) || /* 最小値 */
(lvalu.ival > fsptag->sf.su.max)) { /* 最大値チェック */
pcerr(111,"") ; /* 見出しの型と一致していない */
ok = false ;
}
while(lsp4) { /* 重複指定チェック */
if(lsp4->sf.vr.varval == lvalu.ival) { /* 値が同じ */
pcerr(178,"") ; /* 同じものが定義された */
ok = false ;
}
lsp4 = lsp4->sf.vr.nextvr ;
}
}
}
if(ok) { /* 選択定数が正しいものの時 */
itemsu++ ; /* 定数の数を数える */
lspvar = (stp*)Malloc(sizeof(stp));
lspvar->form = variant ;
lspvar->sf.vr.nextvr = lsp1 ;
lspvar->sf.vr.subvar = lsp2 ;
lspvar->sf.vr.varval = lvalu.ival ;/* 選択定数の値 */
lsp1 = lsp2 = lsp4 = lspvar ;
}
if(test=(sy==comma)) insymbol(); /* , ならば次の名札 */
} while(test) ;
if(sy == colon) insymbol() ; /* : ならば次のsymbol */
else pcerr(5,"") ; /* : がない */
if(sy == lparent) insymbol() ; /* ( ならば次のsymbol */
else pcerr(9,"") ; /* ( がない */
mkset(&ws, rparent,semicolon,-1);
orset(&ws, &fsys) ;
fileflag |= fieldlist(ws,&lspfield,&ldisp) ;
/* フィールドの処理 */
if(ldisp > maxsize) maxsize = ldisp ;
lsp5 = lspvar ;
while(lsp5) {
lsp6 = lsp5->sf.vr.subvar ;
lsp5->sf.vr.subvar = lspfield ;
lsp5->size = ldisp ;
lsp5 = lsp6 ;
}
if(sy == rparent) {
insymbol() ;
ws = fsys ;
addset(ws,semicolon) ;
if(! inset(ws,sy)) {
pcerr(6,"") ; /* 不当な記号が現れた */
skip(ws) ; /* fsys+[semicolon]まで読み飛ばし*/
}
}
else pcerr(4,"") ; /* ) がない */
if(sy == semicolon) {
ldisp = minsize ;
insymbol() ;
}
} while(! inset(fsys,sy)) ; /* ; end fsys でなければループ*/
if(itemsu != range) pcerr(179,"") ;/* タグ型で取りえるすべての選択定数
が指定されていない */
*fsp = lspvar ;
**disp = maxsize ;
return(fileflag) ;
}
/**************************************/
/* settype() : 集合型の処理 */
/**************************************/
static stp *settype(Set fsys,boolean packedflag)
{
stp *lsp, *lsp1 ;
int lsize = 1 ;
long lmin , lmax ;
insymbol() ;
if(sy == ofsy) insymbol() ; /* of なら次のsymbol */
else pcerr(8,"") ; /* ofがない */
simpletype(fsys,&lsp1,&lsize) ; /* 基底の型は単純型 */
if(lsp1) {
if((lsp1->form > subrange) || /* scalar,範囲型ではない */
(lsp1 == realptr)) { /* 実数型 */
pcerr(115,"") ; /* 基底の型が順序型でない */
lsp1 = nil ;
}
else { /* 列挙型、範囲型の時 */
getbounds(lsp1,&lmin,&lmax) ; /* 型の最小値、最大値を求める */
if((lmin < (long)setlow) ||
((long)sethigh < lmax)) /* 集合の要素数チェック */
pcerr(606,inttoch((long)sethigh)) ;/* 基底型の順序数範囲越え */
}
}
lsp = (stp*)Malloc(sizeof(stp)) ;
lsp->form = power ; /* 集合型 */
lsp->size = setsize ; /* 集合の大きさ */
lsp->sf.pw.packed= packedflag ; /* packed指定有無 */
lsp->sf.pw.elset = lsp1 ; /* 要素の型 */
lsp->sf.pw.elmin = (int)lmin ; /* 要素の最小値 */
lsp->sf.pw.elmax = (int)lmax ; /* 要素の最大値 */
return(lsp) ;
}
/**************************************/
/* filetype() : ファイル型の処理 */
/**************************************/
static stp *filetype(Set fsys,boolean packedflag)
{
stp *lsp,*lsp1 ;
int lsize ;
boolean fileflag ;
insymbol() ;
if(sy == ofsy) insymbol() ;
else pcerr(8,"") ; /* of がない */
fileflag = typ(fsys,&lsp1,&lsize) ;/* 基底の型の処理 */
if(fileflag) pcerr(112,"") ; /* 代入可能な型でない */
lsp = (stp*)Malloc(sizeof(stp)) ;
lsp->form = files ; /* ファイル型 */
lsp->size = lsp1->size ; /* 基底の型の大きさ */
lsp->sf.fi.packed = packedflag ; /* packed指定有無 */
lsp->sf.fi.texttype = false ; /* file of ~ は text型でない */
lsp->sf.fi.filtype = lsp1 ; /* 基底の型 */
return(lsp) ;
}
/**************************************/
/* packedtype() : packed の処理 */
/**************************************/
static boolean packedtype(Set fsys)
{
boolean packedflag ; /* packed 指定の時 true */
Set ws ;
if(packedflag=(sy == packedsy)) { /* packedの記述がある時 */
insymbol() ; /* 次のsymbolを読む */
if(! inset(typedels,sy)) { /* array,record,set,file以外 */
pcerr(10,"") ; /* 型の記述に誤りがある */
ws = fsys ;
orset(&ws,&typedels) ;
skip(ws) ; /* fsys+typedlesまで読み飛ばし*/
}
}
return(packedflag) ;
}